Shareware Grab Bag/Shareware Grab Bag.iso/001/pibt3sp4.arc/SETINPTK.PAS

Pascal/Delphi Source File | 1985-09-06 | 25.5 KB | 678 lines

(*----------------------------------------------------------------------*)
(*                Set_Input_Keys --- Set Input Key Values               *)
(*----------------------------------------------------------------------*)

OVERLAY PROCEDURE Set_Input_Keys( File_Name : AnyStr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Set_Input_Keys                                       *)
(*                                                                      *)
(*     Purpose:    Set values of function keys and keypad keys          *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Set_Input_Keys( File_Name : AnyStr );                         *)
(*                                                                      *)
(*           If not null is file name to read key definitions from.     *)
(*                                                                      *)
(*     Calls:                                                           *)
(*               Menu_Display_Choices                                   *)
(*               Menu_Get_Choices                                       *)
(*               Read_Key_Defs_From_File;                               *)
(*               Get_Key_Defs_From_Keyboard;                            *)
(*               Write_Key_Defs_To_File;                                *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        This whole section of code should be reworked to use          *)
(*        full-screen editing at some point.                            *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Input_Key_File      : TEXT;
   Input_Key_File_Name : AnyStr;
   Key_Name            : STRING[3];
   Key_Text            : AnyStr;
   Section_No          : INTEGER;
   Key_Def_Text        : AnyStr;
   Key_Number          : INTEGER;
   L_Text              : INTEGER;
   I                   : INTEGER;
   J                   : INTEGER;
   Input_Key_Menu      : Menu_Type;
   Done                : BOOLEAN;
   Key_Type            : INTEGER;

(*----------------------------------------------------------------------*)
(*  Process_Function_Key_Definition --- Process Function Key Definition *)
(*----------------------------------------------------------------------*)

PROCEDURE Process_Key_Definition;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Process_Key_Definition                               *)
(*                                                                      *)
(*     Purpose:    Process and store key definition string              *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Process_Key_Definition;                                       *)
(*                                                                      *)
(*           On entry, Key_Text should have the key definition text     *)
(*           as read from a file.                                       *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

(* STRUCTURED *) CONST
   Keypad_Nos:  ARRAY[0..10] OF BYTE
                = ( 9, 7, 4, 8, 2, 0, 3, 5, 1, 6, 10 );

BEGIN (* Process_Key_Definition *)

   L_Text         := LENGTH( Key_Text );

                                   (* Get key name   *)

   Key_Name       := COPY( Key_Text, 1, 2 );
   IF Key_Text[3] <> '=' THEN
      Key_Name := Key_Name + Key_Text[3];

                                   (* Choose section *)
   CASE UpCase( Key_Name[1] ) OF

      'F': Section_No := 1;

      'S': Section_No := 2;

      'C': IF UpCase( Key_Name[2] ) = 'K' THEN
              Section_No := 7
           ELSE
              Section_No := 3;

      'A': IF UpCase( Key_Name[2] ) = 'K' THEN
              Section_No := 6
           ELSE
              Section_No := 4;

      'K': Section_No := 5;

      ELSE
           Section_No := 0;

   END (* Case *);
                                   (* Key text initially null *)
   Key_Def_Text   := '';
                                   (* Get key number *)
   I              := 2;
   Key_Number     := 0;

   WHILE ( I <= L_Text ) AND ( Key_Text[I] <> '=' ) DO
      BEGIN

         CASE Key_Text[I] OF
            '0'..'9': Key_Number := Key_Number * 10 + ORD(Key_Text[I]) - ORD('0');
            '.'     : Key_Number := 10;
         END (* Case *);

         I          := I + 1;

      END;
                                   (* Skip past '=' sign *)

   IF Key_Text[I] = '=' THEN I := I + 1;

                                   (* Get key text *)
   IF ( L_Text - I + 1 ) > 0 THEN
      Key_Def_Text   := Read_Ctrls( COPY( Key_Text, I, L_Text - I + 1 ) );

                                   (* Insert key text in function key *)
                                   (* or keypad key.                  *)
   IF Section_No IN [1..4] THEN
      BEGIN
         IF ( Key_Number > 0 ) AND ( Key_Number < 11 ) THEN
              Function_Keys[ Section_No , Key_Number ] := Key_Def_Text;
      END
   ELSE IF Section_No IN [5..7] THEN
      BEGIN
         IF ( Key_Number >= 0 ) AND ( Key_Number < 11 ) THEN
              Keypad_Keys[ Section_No - 4 , Keypad_Nos[ Key_Number ] ]
                 := Key_Def_Text;
      END;

END   (* Process_Key_Definition *);

(*----------------------------------------------------------------------*)
(*      Read_Key_Defs_From_File --- get key definitions from file       *)
(*----------------------------------------------------------------------*)

PROCEDURE Read_Key_Defs_From_File;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Read_Key_Defs_From_File                              *)
(*                                                                      *)
(*     Purpose:    Reads function key and keypad key values from file   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Read_Key_Defs_From_File;                                      *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN (* Read_Key_Defs_From_File *)

                                   (* Announce input key definition *)
   Save_Screen( Saved_Screen );
   Draw_Menu_Frame( 10, 10, 65, 15, Menu_Frame_Color,
                    Menu_Text_Color, 'Read Input Key Definitions' );

                                   (* Prompt for file with definitions *)
                                   (* if not already specified         *)

   Input_Key_File_Name := File_Name;

   WRITELN;
   WRITE('File with definitions? ');

   IF LENGTH( Input_Key_File_Name ) <= 0 THEN
      READLN( Input_Key_File_Name )
   ELSE
      BEGIN
         WRITE( Input_Key_File_Name );
         DELAY( One_Second_Delay );
      END;

                                   (* Assume .FNC if type not given *)

   IF ( POS( '.', Input_Key_File_Name ) = 0 ) THEN
      Input_Key_File_Name := Input_Key_File_Name + '.FNC';

                                   (* Attach file with definitions *)

   ASSIGN( Input_Key_File , Input_Key_File_Name );
       (*$I-*)
   RESET ( Input_Key_File );
       (*$I+*)
                                   (* See if openable *)
   IF IoResult <> 0 THEN
      BEGIN (* File bad *)
         WRITELN;
         WRITELN('*** File ',Input_Key_File_Name,' can''t be found.');
         DELAY( Two_Second_Delay );
      END   (* File bad *)
   ELSE
      BEGIN (* File OK, read definitions *)

         REPEAT

            Key_Text       := ' ';
                                   (* Read key definition *)

            READLN( Input_Key_File , Key_Text );

                                   (* Process it *)

            Process_Key_Definition;

         UNTIL( EOF( Input_Key_File ) );

                                   (* Indicate definitions finished *)

         WRITELN('Function key definitions loaded.');

         DELAY( Two_Second_Delay );

         CLOSE( Input_Key_File );

      END   (* File OK, read definitions *);

                                   (* Restore previous screen          *)
   Restore_Screen( Saved_Screen );

   Reset_Global_Colors;

END   (* Read_Key_Defs_From_File *);

(*----------------------------------------------------------------------*)
(*       Get_Key_Defs_From_Keyboard --- get key defs. from keyboard     *)
(*----------------------------------------------------------------------*)

PROCEDURE Get_Key_Defs_From_Keyboard;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Get_Key_Defs_From_Keyboard                           *)
(*                                                                      *)
(*     Purpose:    Read function and keypad key values from keyboard    *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Get_Key_Defs_From_Keyboard;                                   *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Local_Save : Saved_Screen_Ptr;
   Page_No    : INTEGER;
   Key_Menu   : Menu_Type;
   Key_Type   : INTEGER;
   Defs_Done  : BOOLEAN;

(*----------------------------------------------------------------------*)
(*       Display_Key_Defs --- Display current key definitions           *)
(*----------------------------------------------------------------------*)

PROCEDURE Display_Key_Defs( Key_Type : INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Display_Key_Defs                                     *)
(*                                                                      *)
(*     Purpose:    Display portion of current key definitions           *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Display_Key_Defs( Key_Type: INTEGER );                        *)
(*                                                                      *)
(*           Key_Type --- Key type to display.                          *)
(*                        = 1:  F1 through F10                          *)
(*                        = 2:  Shift F1 through Shift F10              *)
(*                        = 3:  Ctrl F1 through Ctrl F10                *)
(*                        = 4:  Alt F1 through Alt F10                  *)
(*                        = 5:  Keypad keys                             *)
(*                        = 6:  Alt keypad keys                         *)
(*                        = 7:  Ctrl keypad keys                        *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

(* STRUCTURED *) CONST
   Long_Key_Names : ARRAY[1..10] OF STRING[7] =
                    ( 'Up', 'Left', 'Right', 'Down',
                      'Home', 'PgUp', 'End', 'PgDn', 'Ins', 'Del' );

VAR
   I          : INTEGER;
   J          : INTEGER;
   Key_Prefix : STRING[10];
   Defs_Done  : BOOLEAN;

BEGIN (* Display_Key_Defs *)

   GoToXY( 1 , 1 );
                                   (* Display title                *)

   WRITELN(' # -Key Name- ',
           '------------------------Definition-------------------------- ');
   WRITELN(' ');

   CASE Key_Type OF

      1:  Key_Prefix := 'F';
      2:  Key_Prefix := 'Shift F';
      3:  Key_Prefix := 'Ctrl F';
      4:  Key_Prefix := 'Alt F';
      5:  Key_Prefix := '';
      6:  Key_Prefix := 'Alt ';
      7:  Key_Prefix := 'Ctrl ';
      ELSE;

   END (* Case *);

   IF Key_Type IN [1..4] THEN
      FOR I := 1 TO 10 DO
         BEGIN
            GoToXY( 1 , I + 3 );
            ClrEol;
            WRITE( I:2,' ',Key_Prefix , I );
            GoToXY( 15 , I + 3 );
            WRITE( Function_Keys[ Key_Type , I ] );
         END
   ELSE
      FOR I := 1 TO 10 DO
         BEGIN
            GoToXY( 1 , I + 3 );
            ClrEol;
            WRITE( I:2,' ',Key_Prefix , Long_Key_Names[I] );
            GoToXY( 15 , I + 3 );
            WRITE( Keypad_Keys[ Key_Type - 4 , I ] );
         END;

   FOR I := 14 TO 19 DO
      BEGIN
         GoToXY( 1 , I );
         ClrEol;
      END;

END   (* Display_Key_Defs *);

(*----------------------------------------------------------------------*)
(*              Update_Key_Defs --- Update key definitions              *)
(*----------------------------------------------------------------------*)

PROCEDURE Update_Key_Defs( Key_Type: INTEGER; VAR Defs_Done : BOOLEAN );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Update_Key_Defs                                      *)
(*                                                                      *)
(*     Purpose:    Update key definitions                               *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Update_Key_Defs( Key_Type: INTEGER; VAR Defs_Done: BOOLEAN ); *)
(*                                                                      *)
(*           Key_Type --- Key type to define.                           *)
(*                        = 1:  F1 through F10                          *)
(*                        = 2:  Shift F1 through Shift F10              *)
(*                        = 3:  Ctrl F1 through Ctrl F10                *)
(*                        = 4:  Alt F1 through Alt F10                  *)
(*                        = 5:  Keypad keys                             *)
(*                        = 6:  Alt keypad keys                         *)
(*                        = 7:  Ctrl keypad keys                        *)
(*                                                                      *)
(*           Defs_Done --- TRUE if definitions complete.                *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Key_No     : INTEGER;
   Key_No_Str : STRING[10];
   OK_Number  : BOOLEAN;
   I          : INTEGER;

BEGIN (* Update_Key_Defs *)
                                   (* Not through with definitions yet *)
   Defs_Done := FALSE;
                                   (* Get number of key to change *)
   REPEAT
                                   (* Assume good key number found     *)
      OK_Number := TRUE;
                                   (* Clear any previous error         *)
      GoToXY( 1 , 17 );
      ClrEol;

      GoToXY( 1 , 16 );

      WRITE(' Enter key number to redefine or <CR> to quit: ');
      ClrEol;

      READLN( Key_No_Str );

      Defs_Done := ( LENGTH( Key_No_Str ) = 0 );

      Key_No := 0;

      IF ( NOT Defs_Done ) THEN
         BEGIN
            FOR I := 1 TO LENGTH( Key_No_Str ) DO
               IF Key_No_Str[I] IN ['0'..'9'] THEN
                  Key_No := Key_No * 10 + ORD(Key_No_Str[I]) - ORD('0')
               ELSE
                  OK_Number := FALSE;
            OK_Number := OK_Number AND ( Key_No > 0 ) AND ( Key_No < 11 );
         END;

      IF ( NOT OK_Number ) THEN
         BEGIN
            GoToXY( 1 , 17 );
            WRITE(' *** Bad key number, try again.');
            ClrEol;
            DELAY( 1000 );
         END;

   UNTIL ( OK_Number OR Defs_Done );

                                   (* If no number entered, quit; *)
                                   (* else, pick up definition.   *)
   IF ( NOT Defs_Done ) THEN
      BEGIN
         GoToXY( 1 , 17 );
         WRITELN(' Enter new key definition ...');
         WRITE(' -->');
         ClrEol;
         READLN( Key_Text );
                                    (* Store new key definition *)

         IF Key_Type IN [1..4] THEN
            Function_Keys[Key_Type,Key_No] := Read_Ctrls( Key_Text )
         ELSE
            Keypad_Keys[Key_Type - 4, Key_No] := Read_Ctrls( Key_Text );

      END;

END   (* Update_Key_Defs *);

(*----------------------------------------------------------------------*)

BEGIN (* Get_Key_Defs_From_Keyboard *)

                                   (* Save screen *)
   Save_Screen( Local_Save );
                                   (* Get back whole screen as window *)
                                   (* for key display                 *)
   Window( 1, 1, 80, 25 );

   ClrScr;

   Draw_Menu_Frame( 1, 2, 80, 23, Menu_Frame_Color,
                    Menu_Text_Color, 'Input key definition' );

   Window( 2, 3, 78, 22 );
                                   (* Set up menu *)
   Key_Menu.Menu_Size    := 8;
   Key_Menu.Menu_Row     := 11;
   Key_Menu.Menu_Column  := 15;
   Key_Menu.Menu_Tcolor  := Menu_Text_Color;
   Key_Menu.Menu_Bcolor  := BackGround_Color;
   Key_Menu.Menu_Fcolor  := Menu_Frame_Color;
   Key_Menu.Menu_Width   := 0;
   Key_Menu.Menu_Height  := 0;
   Key_Menu.Menu_Default := 1;

   FOR I := 1 TO 8 DO
      WITH Key_Menu.Menu_Entries[I] DO
      BEGIN
         Menu_Item_Row    := I;
         Menu_Item_Column := 2;
         CASE I Of
            1:  Menu_Item_Text:= '1) Function keys 1 to 10';
            2:  Menu_Item_Text:= '2) Shifted function keys';
            3:  Menu_Item_Text:= '3) Ctrl + function keys';
            4:  Menu_Item_Text:= '4) Alt + function keys';
            5:  Menu_Item_Text:= '5) Keypad keys';
            6:  Menu_Item_Text:= '6) Alt + keypad keys';
            7:  Menu_Item_Text:= '7) Ctrl + keypad keys';
            8:  Menu_Item_Text:= '8) Quit';
         END (* CASE *);
      END;

   Key_Menu.Menu_Title := 'Select keys to define:';

                                   (* Loop until quit chosen *)
   Done := FALSE;

   REPEAT
                                   (* Display menu of choices *)

      Menu_Display_Choices( Key_Menu );
      Key_Type := Menu_Get_Choice( Key_Menu , Erase_Menu );

                                   (* Do requested operation *)
      IF Key_Type <> 8 THEN
         REPEAT
            Display_Key_Defs( Key_Type );
            Update_Key_Defs( Key_Type , Defs_Done );
         UNTIL( Defs_Done )
      ELSE
         Done := TRUE;

   UNTIL Done;
                                   (* Restore previous screen          *)
   Restore_Screen( Local_Save );

   Reset_Global_Colors;

END   (* Get_Key_Defs_From_Keyboard *);

(*----------------------------------------------------------------------*)
(*  Write_Key_Defs_To_File --- write revised key definitions to file    *)
(*----------------------------------------------------------------------*)

PROCEDURE Write_Key_Defs_To_File;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Write_Key_Defs_To_File                               *)
(*                                                                      *)
(*     Purpose:    Write updated function key and keypad key values     *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Write_Key_Defs_To_File;                                       *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Local_Save : Saved_Screen_Ptr;

BEGIN (* Write_Key_Defs_To_File *)

                                   (* Indicate write to file *)
   Save_Screen( Local_Save );

   Draw_Menu_Frame( 10, 10, 75, 13, Menu_Frame_Color,
                    Menu_Text_Color, 'Write Function Key Definitions' );

                                   (* Get name of file to write to *)
   GoToXY( 2 , 1 );
   WRITE('Enter file name to write definitions to (CR to exit): ');
   ClrEol;

   READLN( Input_Key_File_Name );
                                   (* Assume .FNC if type not given *)

   IF ( POS( '.', Input_Key_File_Name ) = 0 ) THEN
      Input_Key_File_Name := Input_Key_File_Name + '.FNC';

                                   (* Ensure file can be opened *)

   IF LENGTH( Input_Key_File_Name ) > 0 THEN
      BEGIN

         ASSIGN( Input_Key_File , Input_Key_File_Name );
            (*$I-*)
         REWRITE( Input_Key_File );
            (*$I+*)

         IF IoResult <> 0 THEN
            BEGIN (* File bad *)

               GoToXY( 2 , 2 );
               WRITE('*** File ',Input_Key_File_Name,' can''t be opened.');
               ClrEol;

               DELAY( Two_Second_Delay );

            END   (* File bad *)
         ELSE
            BEGIN (* File OK, definitions written *)

                                   (* Write out function keys *)

               FOR I := 1 TO 4 DO
                  FOR J := 1 TO 10 DO
                     IF LENGTH( Function_Keys[I,J] ) > 0 THEN
                        WRITELN( Input_Key_File, COPY( 'FSCA', I, 1 ),
                                 J:2, '=', Write_Ctrls(Function_Keys[I,J]) );

                                   (* Write out keypad keys *)

               FOR I := 1 TO 3 DO
                  FOR J := 1 TO 10 DO
                     IF LENGTH( Keypad_Keys[I,J] ) > 0 THEN
                        WRITELN( Input_Key_File,
                                 Keypad_Key_Names[I,J], '=',
                                 Write_Ctrls(Keypad_Keys[I,J]) );

               CLOSE( Input_Key_File );

               GoToXY( 2 , 2 );

               WRITE('Function key definitions written to ',
                      Input_Key_File_Name );

               ClrEol;

               DELAY( Two_Second_Delay );

            END   (* File OK, definitions written *);

      END;
                                   (* Restore previous screen          *)
   Restore_Screen( Local_Save );

END   (* Write_Key_Defs_To_File *);

(*----------------------------------------------------------------------*)

BEGIN (* Set_Input_Keys *)
                                   (* If file name specified, get keys *)
                                   (* from specified file.             *)

   IF LENGTH( File_Name ) > 0 THEN
      BEGIN
         Read_Key_Defs_From_File;
         EXIT;
      END;
                                   (* Set up menu *)

   Input_Key_Menu.Menu_Size    := 4;
   Input_Key_Menu.Menu_Row     := 11;
   Input_Key_Menu.Menu_Column  := 15;
   Input_Key_Menu.Menu_Tcolor  := Menu_Text_Color;
   Input_Key_Menu.Menu_Bcolor  := BackGround_Color;
   Input_Key_Menu.Menu_Fcolor  := Menu_Frame_Color;
   Input_Key_Menu.Menu_Width   := 0;
   Input_Key_Menu.Menu_Height  := 0;
   Input_Key_Menu.Menu_Default := 1;

   FOR I := 1 TO 4 DO
      WITH Input_Key_Menu.Menu_Entries[I] DO
      BEGIN
         Menu_Item_Row    := I;
         Menu_Item_Column := 2;
         CASE I Of
            1:  Menu_Item_Text:= 'R)ead definitions from file';
            2:  Menu_Item_Text:= 'E)nter definitions from keyboard';
            3:  Menu_Item_Text:= 'W)rite definitions to file';
            4:  Menu_Item_Text:= 'Q)uit key definition';
         END (* CASE *);
      END;

   Input_Key_Menu.Menu_Title := 'Choose Key Definition Method: ';

                                   (* Loop until quit chosen *)
   Done := FALSE;

   REPEAT
                                   (* Display menu of choices *)

      Menu_Display_Choices( Input_Key_Menu );
      Key_Type := Menu_Get_Choice( Input_Key_Menu , Erase_Menu );

                                   (* Do requested operation *)
      CASE Key_Type OF

         1: Read_Key_Defs_From_File;
         2: Get_Key_Defs_From_Keyboard;
         3: Write_Key_Defs_To_File;
         4: Done := TRUE;

      END (* CASE *);

   UNTIL Done;

END   (* Set_Input_Keys *);